home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-19
/
rcdsplay.zip
/
IOFUNCS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-18
|
25KB
|
632 lines
{**********************************************************************
Unit : IOFUNCS
Version: 1.8
Purpose: This unit contains useful procedures to simplify IO tasks.
Author : Translated form those of Mike Riebe (MISFUNCS, version 3.3)
by Roger Carlson.
Changes: 5/17/90 (RJC,1.1) - Added the procedures of version 1.7 of
RCGRAF.
5/31/90 (RJC,1,2) - Removed the RLTOSTR, DBLTOSTR, LNGTOSTR,
and INTTOSTR procedures which are more easily implemented
by Turbo Pascal's STR procedure.
6/9/90 (RJC,1.3) - Added graphics mode rdstr procedures and
INTTOSTR.
2/15/91 (RJC,1.4) - Added line feed at end of some procedures.
3/28/91 (RJC,1.5) - Added RLTOSTR funciton and the graphics
mode GRDINT procedure.
5/3/91 (RJC,1.6) - Added graphics mode GRDDBL and GRDREAL
procedures.
5/11/91 (RJC,1.7) - Added the DOS shell command DOS_CMD.
5/18/91 (RJC,1.8) - Added LNGTOSTR function and RDLONGLN
procedure.
***********************************************************************}
UNIT IOFUNCS;
INTERFACE
TYPE STR160 = STRING[160]; STR80 = STRING[80]; STR40 = STRING[40];
STR30 = STRING[30]; STR20 = STRING[20]; STR3 = STRING[3];
PROCEDURE rdrealn(VAR window : TEXT; VAR value : REAL);
PROCEDURE rddbln(VAR window : TEXT; VAR value : DOUBLE);
PROCEDURE rdintln(VAR window : TEXT; VAR value : INTEGER);
PROCEDURE RDLONGLN(VAR WINDOW:TEXT; VAR VALUE:LONGINT);
PROCEDURE rdstr160(VAR window : TEXT; VAR value : STR160);
PROCEDURE rdstr80(VAR WINDOW:TEXT; VAR value:STR80);
PROCEDURE rdstr40(VAR WINDOW:TEXT; VAR value:STR40);
PROCEDURE rdstr30(VAR WINDOW:TEXT; VAR value:STR30);
PROCEDURE rdstr20(VAR window : TEXT; VAR value : STR20);
PROCEDURE rdstr3(VAR window : TEXT; VAR value : STR3);
PROCEDURE rdcharln(VAR window : TEXT; VAR value : CHAR);
PROCEDURE GRDSTR160(VAR VALUE:STR160);
PROCEDURE GRDSTR80(VAR VALUE:STR80);
PROCEDURE GRDSTR40(VAR VALUE:STR40);
PROCEDURE GRDSTR30(VAR VALUE:STR30);
PROCEDURE GRDSTR20(VAR VALUE:STR20);
PROCEDURE GRDSTR3(VAR VALUE:STR3);
PROCEDURE GRDCHAR(VAR VALUE:CHAR);
PROCEDURE GRDINT(VAR VALUE:INTEGER);
PROCEDURE GRDDBL(VAR VALUE:DOUBLE);
PROCEDURE GRDREAL(VAR VALUE:REAL);
FUNCTION CALCINCR(INCR:DOUBLE):DOUBLE;
{This function returns the largest power of 1, 2, or 5 <= INCR and can be
used to calculate round number intervals for labeling of plots. INCR
should be a positive number.}
PROCEDURE ENGNOT(NUMBER:DOUBLE; VAR MANTISSA:DOUBLE; VAR EXPONENT:LONGINT);
{This procedure calculates the engineering notation mantissa and exponent
for the number NUMBER.}
FUNCTION NUMDEC(NUM:DOUBLE):INTEGER;
{Calculates the number of decimals in a number to an accuracy of about 1
part in 1E6}
FUNCTION EXISTS(FILENAME:STR30):BOOLEAN;
PROCEDURE BEEP(HZ:WORD);
FUNCTION INTTOSTR(I:INTEGER):STR80; {Converts an integer to a string.}
FUNCTION LNGTOSTR(I:LONGINT):STR80; {Converts a long integer to a string.}
FUNCTION RLTOSTR(RL:REAL;WIDTH:INTEGER):STR80;
{Converts a real number to a string.}
PROCEDURE DOS_CMD; {executes a dos command}
IMPLEMENTATION
USES CRT, GRAPH, DOS, MATH;
{************************ PROCEDURE DOS_CMD **************************}
PROCEDURE DOS_CMD;
VAR NAME:STR80;
BEGIN
CLRSCR;
WRITE('Command: '); RDSTR80(OUTPUT,NAME); WRITELN;
SWAPVECTORS; EXEC('C:\COMMAND.COM',CONCAT('/C ',NAME)); SWAPVECTORS;
IF DOSERROR<>0 THEN WRITELN('DOS ERROR # ',DOSERROR);
WRITE('Hit <ENTER> to continue.'); READLN;
END;
{******************************************************************************
TITLE: RDREALN(VAR WINDOW:TEXT; VAR VALUE : REAL);
FUNCTION: To provide a mechanism for reading real numbers from the keyboard
as well as provide for keeping the current value of the variable
to be read by inputing a carriage return.
INPUTS: A string of digits including '+','-','.',and 'E' defining a real
value.
OUTPUTS: A new value for a variable unless <CR> was the only character
in the input string.
AUTHOR: M. Riebe 11/17/84
CHANGES: 12/06/84: Fixed procedure for finding starting index so that only
digits are valid.
5/15/85 MTR: Fixed correction procedure to allow backspaces.
6/20/85 RJC: Improved error correction.
10/1/85 MTR: Changed to use RDDBLN and convert to real.
10/30/85 RJC:Fixed so that value unchanged if return is entered.
4/8/90 RJC:Translated to Turbo Pascal.
******************************************************************************}
PROCEDURE RDREALN;
VAR DBLTEMP:DOUBLE;
BEGIN DBLTEMP:=VALUE; RDDBLN(WINDOW,DBLTEMP); VALUE:=DBLTEMP; END;
{******************************************************************************
TITLE: RDDBLN(VAR WINDOW:TEXT; VAR VALUE:DOUBLE)
VERSION: 1.1
FUNCTION: Input of double precision real numbers interactively from the
keyboard.
AUTHOR: RJC 9/29/85
CHANGES: (4/8/90, 1.1, RJC) - Translated to Turbo Pascal. Modified to
prevent reading of spurious characters and backspacing before
the first character.
******************************************************************************}
PROCEDURE RDDBLN;
VAR
CH : CHAR;
I,J,K,L,M,N,POWVAL : INTEGER;
ASCII : ARRAY[1..20] OF INTEGER;
NEG,POWNEG : BOOLEAN;
BEGIN {1}
NEG := FALSE; POWNEG := FALSE; POWVAL := 0; I := 1;
REPEAT
REPEAT CH:=READKEY
UNTIL CH IN ['0'..'9','+','-','D','E','.',CHR(13),CHR(8)];
ASCII[I]:=ORD(CH);
IF (ASCII[I] = 8) THEN BEGIN
IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
IF I<=2 THEN I:=0 ELSE I:=I-2;
END
ELSE WRITE(WINDOW,CH);
I:=I+1;
UNTIL ORD(CH)=13;
I:=I-1; {leave index at last character}
IF ASCII[1]<>13 THEN BEGIN {2}
VALUE:=0; J:=0; K:=0;
REPEAT J:=J+1 UNTIL ASCII[J] IN [43,45..58];
REPEAT K:=K+1 UNTIL ASCII[K] IN [46,68,69,13];
CASE ASCII[J] OF
43 {+}: J:=J+1;
45 {-}: BEGIN NEG:=TRUE; J:=J+1; END;
END; {CASE}
FOR L:=J TO (K-1) DO VALUE:=VALUE+(ASCII[L]-48)*PWROF10(K-L-1);
IF ASCII[K]=46 THEN BEGIN {'.'}
M := K;
REPEAT M:= M + 1 UNTIL ASCII[M] IN [68,69,13];
FOR N:=K+1 TO M-1 DO VALUE:=VALUE+(ASCII[N]-48)/PWROF10(N-K);
K := M;
END; {IF}
IF ASCII[K] IN [68,69] THEN BEGIN {'D' or 'E'}
CASE ASCII[K+1] OF
43 {+}: K:=K+1;
45 {-}: BEGIN POWNEG:=TRUE; K:=K+1; END;
END; {CASE}
FOR N:=K+1 TO I-1 DO POWVAL:=POWVAL+
(ASCII[N]-48)*ROUND(PWROF10(I-N-1));
END; {IF}
IF NEG THEN VALUE:=VALUE*(-1);
IF POWNEG THEN VALUE := VALUE/PWROF10(POWVAL)
ELSE VALUE := VALUE*PWROF10(POWVAL);
END; {2}
WRITE(WINDOW,CHR($0A)); {line feed}
END; {1}
{******************************************************************************
TITLE: rdintln(VAR WINDOW:TEXT; VAR VALUE:INTEGER);
FUNCTION: To provide a mechanism for reading integers from the keyboard
while providing for keeping the current value of the variable
if a carriage return is input.
INPUTS: A string of digits followed by a <CR> or just a <CR>.
OUTPUTS: A new value for the variable value unless <CR> was the only
character in the input string.
NOTES: Should someday be modified to allow input from any file type,
i.e., not just INPUT.
AUTHOR: M. Riebe 11/17/84
CHANGES: 5/15/85 MTR: Fixed input routine to allow backspaces for
corrections.
6/20/85 RJC: Improved error correction.
5/8/90 RJC: Translated to Turbo Pascal. Added same changes
as versions 1.1 of RDDBLN.
5/18/91 RJC: Corrected number of digits error to allow up to
6 digits.
******************************************************************************}
PROCEDURE rdintln;
VAR
CH : CHAR;
ascii : array[1..10] of INTEGER;
I,J,START : INTEGER;
NEG : BOOLEAN;
BEGIN
NEG:=FALSE; START:=0; I:=1;
REPEAT
IF I>=7 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
ASCII[I]:=ORD(CH);
IF (ASCII[I] = 8) THEN BEGIN
IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
IF I<=2 THEN I:=0 ELSE I:=I-2;
END
ELSE WRITE(WINDOW,CH);
I:=I+1;
UNTIL ORD(CH)=13;
I:=I-1; {leave index at last character}
IF ascii[1] <> 13 THEN BEGIN
REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
IF ASCII[1]=45 THEN NEG:=TRUE;
value := 0;
FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
IF NEG THEN VALUE:=-VALUE;
END;
WRITE(WINDOW,CHR($0A)); {line feed}
END;
{******************************************************************************
TITLE: RDLONGLN(VAR WINDOW:TEXT; VAR VALUE:LONGINT);
FUNCTION: To provide a mechanism for reading long integers from the
keyboard while providing for keeping the current value of
the variable if a carriage return is input.
INPUTS: A string of digits followed by a <CR> or just a <CR>.
OUTPUTS: A new value for the variable value unless <CR> was the only
character in the input string.
AUTHOR: R. Carlson 5/18/91
CHANGES:
******************************************************************************}
PROCEDURE RDLONGLN;
VAR
CH : CHAR;
ascii : array[1..13] of INTEGER;
I,J,START : INTEGER;
NEG : BOOLEAN;
BEGIN
NEG:=FALSE; START:=0; I:=1;
REPEAT
IF I>=12 THEN
REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
ASCII[I]:=ORD(CH);
IF (ASCII[I] = 8) THEN BEGIN
IF I<>1 THEN WRITE(WINDOW,CH,' ',CH);
IF I<=2 THEN I:=0 ELSE I:=I-2;
END
ELSE WRITE(WINDOW,CH);
I:=I+1;
UNTIL ORD(CH)=13;
I:=I-1; {leave index at last character}
IF ascii[1] <> 13 THEN BEGIN
REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
IF ASCII[1]=45 THEN NEG:=TRUE;
value := 0;
FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
IF NEG THEN VALUE:=-VALUE;
END;
WRITE(WINDOW,CHR($0A)); {line feed}
END;
PROCEDURE RDSTR(VAR WINDOW:TEXT; VAR VALUE:STR160; MAX:INTEGER);
{******************************************************************************
FUNCTION: To read a string input and if the input is not <CR>, assign it
to the variable.
INPUTS: A string of length MAX up to 160 characters.
OUTPUTS: The input string if it was not simply a <CR>.
AUTHOR: Adapted by Roger Carlson from rdstr160 of M. Riebe.
******************************************************************************}
VAR INSTRING:STR160; C:STRING[1]; CH:CHAR;
BEGIN
INSTRING:='';
REPEAT
IF LENGTH(INSTRING)>=MAX THEN
REPEAT CH:=READKEY UNTIL CH IN [CHR(8),CHR(13)]
ELSE REPEAT CH:=READKEY UNTIL CH<>#0;
IF NOT ((LENGTH(INSTRING)=0) AND (CH=CHR(8))) THEN
IF CH=CHR(8) THEN WRITE(WINDOW,CH,' ',CH) ELSE WRITE(WINDOW,CH);
C[0]:=CHR(1); C[1]:=CH;
IF ORD(CH)=8 THEN DELETE(INSTRING,LENGTH(INSTRING),1)
ELSE IF ORD(CH)<>13 THEN INSTRING:=CONCAT(INSTRING,C);
UNTIL ORD(CH)=13;
WRITE(WINDOW,CHR($0A)); {line feed}
IF INSTRING<>'' THEN VALUE:=INSTRING;
END;
PROCEDURE GRDSTR(VAR VALUE:STR160; MAX:INTEGER);
{******************************************************************************
FUNCTION: To read a string input with echoing to the graphics screen.
If the string is unchanged if a carriage return is entered.
INPUTS: A string of length MAX up to 160 characters.
OUTPUTS: The input string if it was not simply a <CR>.
AUTHOR: Adapted by Roger Carlson from rdstr160 of M. Riebe.
******************************************************************************}
VAR INSTRING :STR160; C:STRING[1]; CH:CHAR;
SETTINGS : TEXTSETTINGSTYPE;
DX,X,Y : INTEGER;
VIEWPORT : VIEWPORTTYPE;
BEGIN
GETTEXTSETTINGS(SETTINGS);
GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
DX:=SETTINGS.CHARSIZE*8;
INSTRING:='';
REPEAT
IF LENGTH(INSTRING)>=MAX THEN
REPEAT CH:=READKEY UNTIL CH IN [CHR(8),CHR(13)]
ELSE REPEAT CH:=READKEY UNTIL CH<>#0;
IF NOT ((LENGTH(INSTRING)=0) AND (CH=CHR(8))) THEN
IF CH=CHR(8) THEN BEGIN
MOVEREL(-DX,0); X:=GETX; Y:=GETY;
SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
MOVETO(X,Y);
END {IF}
ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
C[0]:=CHR(1); C[1]:=CH;
IF ORD(CH)=8 THEN DELETE(INSTRING,LENGTH(INSTRING),1)
ELSE IF ORD(CH)<>13 THEN INSTRING:=CONCAT(INSTRING,C);
UNTIL ORD(CH)=13;
IF INSTRING<>'' THEN VALUE:=INSTRING;
END;
{******************************************************************************
TITLE: grdint(VAR VALUE:INTEGER);
FUNCTION: To provide a mechanism for reading integers from a graphics
screen.
INPUTS: A string of digits followed by a <CR> or just a <CR>.
OUTPUTS: A new value for the variable value unless <CR> was the only
character in the input string.
AUTHOR: R. Carlson 3/28/91
CHANGES:
******************************************************************************}
PROCEDURE grdint;
VAR
SETTINGS : TEXTSETTINGSTYPE;
DX,X,Y : INTEGER;
VIEWPORT : VIEWPORTTYPE;
CH : CHAR;
ascii : array[1..10] of INTEGER;
I,J,START : INTEGER;
NEG : BOOLEAN;
BEGIN
GETTEXTSETTINGS(SETTINGS);
GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
DX:=SETTINGS.CHARSIZE*8;
NEG:=FALSE; START:=0; I:=1;
REPEAT
IF I>=6 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)]
ELSE REPEAT CH:=READKEY UNTIL CH IN ['0'..'9','+','-',CHR(13),CHR(8)];
ASCII[I]:=ORD(CH);
IF NOT ((I=1) AND (CH=CHR(8))) THEN BEGIN
IF CH=CHR(8) THEN BEGIN
IF I<>1 THEN BEGIN
MOVEREL(-DX,0); X:=GETX; Y:=GETY;
SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
MOVETO(X,Y);
END; {IF I<>1}
IF I<=2 THEN I:=0 ELSE I:=I-2;
END {IF CH=CHR(8)}
ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
I:=I+1;
END; {IF}
UNTIL ORD(CH)=13;
I:=I-1; {leave index at last character}
IF ascii[1] <> 13 THEN BEGIN
REPEAT START:=START+1 UNTIL ASCII[START] IN [48..57];
IF ASCII[1]=45 THEN NEG:=TRUE;
value := 0;
FOR j:=START to I-1 DO value:=value+(ascii[J]-48)*ROUND(PWROF10(I-J-1));
IF NEG THEN VALUE:=-VALUE;
END;
END;
{******************************************************************************
TITLE: grddbl(VAR VALUE:DOUBLE);
FUNCTION: To provide a mechanism for reading double precision numbers
from a graphics screen.
INPUTS: A string of digits followed by a <CR> or just a <CR>.
OUTPUTS: A new value for the variable value unless <CR> was the only
character in the input string.
AUTHOR: R. Carlson 5/3/91
CHANGES:
******************************************************************************}
PROCEDURE grddbl;
VAR
SETTINGS : TEXTSETTINGSTYPE;
DX,X,Y : INTEGER;
VIEWPORT : VIEWPORTTYPE;
CH : CHAR;
ascii : array[1..12] of INTEGER;
I,J,N,START,START1 : INTEGER;
NEG : BOOLEAN;
POWNEG : BOOLEAN;
POWVAL : INTEGER;
BEGIN
GETTEXTSETTINGS(SETTINGS);
GETVIEWSETTINGS(VIEWPORT); {save the current viewport settings}
DX:=SETTINGS.CHARSIZE*8; I:=1;
REPEAT
IF I>=12 THEN REPEAT CH:=READKEY UNTIL CH IN [CHR(13),CHR(8)];
REPEAT CH:=READKEY
UNTIL CH IN ['0'..'9','.','+','-','E','e',CHR(13),CHR(8)];
ASCII[I]:=ORD(CH);
IF NOT ((I=1) AND (CH IN [CHR(8),'.','e','E'])) THEN BEGIN
IF CH=CHR(8) THEN BEGIN
IF I<>1 THEN BEGIN
MOVEREL(-DX,0); X:=GETX; Y:=GETY;
SETVIEWPORT(X,Y,X+8,Y+8,CLIPON); CLEARVIEWPORT;
SETVIEWPORT(VIEWPORT.X1,VIEWPORT.Y1,VIEWPORT.X2,VIEWPORT.Y2,CLIPON);
MOVETO(X,Y);
END; {IF I<>1}
IF I<=2 THEN I:=0 ELSE I:=I-2;
END {IF CH=CHR(8)}
ELSE IF CH<>CHR(13) THEN OUTTEXT(CH);
I:=I+1;
END; {IF}
UNTIL ORD(CH)=13;
I:=I-1; {leave index at last character}
IF ascii[1] <> 13 THEN BEGIN
START:=0; START1:=0;
REPEAT START:=START+1 UNTIL ASCII[START] IN [43,45,48..57];
REPEAT START1:=START1+1 UNTIL ASCII[START1] IN [46,69,101,13];
NEG:=FALSE;
CASE ASCII[START] OF
45: BEGIN {-} NEG:=TRUE; START:=START+1; END;
43: {+} START:=START+1;
END; {CASE}
value := 0;
FOR J:=START TO (START1-1) DO {left of decimal}
VALUE:=VALUE+(ASCII[J]-48)*PWROF10(START1-J-1);
IF ASCII[START1]=46 THEN BEGIN {'.'}
J:=START1;
REPEAT J:=J+1 UNTIL ASCII[J] IN [69,101,13];
FOR N:=START1+1 TO J-1 DO VALUE:=VALUE+(ASCII[N]-48)/PWROF10(N-START1);
START1:=J;
END;
POWVAL:=0;
IF ASCII[START1] IN [69,101] THEN BEGIN {'E','e'}
START1:=START1+1; POWNEG:=FALSE;
CASE ASCII[START1] OF
45: BEGIN {-} POWNEG:=TRUE; START1:=START1+1; END;
43: {+} START1:=START1+1;
END; {CASE}
FOR N:=START1 TO I-1 DO POWVAL:=POWVAL
+(ASCII[N]-48)*ROUND(PWROF10(I-N-1));
END; {IF}
IF NEG THEN VALUE:=-VALUE;
IF POWNEG THEN VALUE:=VALUE/PWROF10(POWVAL)
ELSE VALUE:=VALUE*PWROF10(POWVAL);
END;
END;
{******************************************************************************
TITLE: GRDREAL(VAR VALUE:REAL);
FUNCTION: To provide a mechanism for reading real numbers from a graphics
screen.
INPUTS: A string of digits followed by a <CR> or just a <CR>.
OUTPUTS: A new value for the variable value unless <CR> was the only
character in the input string.
AUTHOR: R. Carlson 5/3/91
CHANGES:
******************************************************************************}
PROCEDURE GRDREAL;
VAR DBLTEMP:DOUBLE;
BEGIN DBLTEMP:=VALUE; GRDDBL(DBLTEMP); VALUE:=DBLTEMP; END;
{******************************************************************************
TITLE: rdstrxxx(VAR WINDOW:TEXT; VAR VALUE:STRxxx);
FUNCTION: To read a string input and if the input is not <CR>, assign it
to the variable.
INPUTS: A string of up to 160 characters.
OUTPUTS: The input string if it was not simply a <CR>.
AUTHOR: M. Riebe 11/17/84
CHANGES: 12/06/84: Fixed input/output so that it is cleaner.
9/24/85 RJC: Switched to single character reading so that input
can be echoed to any window.
9/25/85 RJC: Modified so that all use rdstr160.
Added rdstr80.
2/04/86 RJC: Added rdstr30 and rdstr40.
Added truncation of strings to the correct size.
4/8/90 RJC: Translated to Turbo Pascal. Modified to use the
local procedure RDSTR.
******************************************************************************}
PROCEDURE RDSTR160;
VAR ST:STR160;
BEGIN ST:=VALUE; RDSTR(WINDOW,ST,160); VALUE:=ST; END;
PROCEDURE GRDSTR160;
VAR ST:STR160;
BEGIN ST:=VALUE; GRDSTR(ST,160); VALUE:=ST; END;
PROCEDURE RDSTR80;
VAR ST:STR160;
BEGIN ST:=VALUE; RDSTR(WINDOW,ST,80); VALUE:=ST; END;
PROCEDURE GRDSTR80;
VAR ST:STR160;
BEGIN ST:=VALUE; GRDSTR(ST,80); VALUE:=ST; END;
PROCEDURE RDSTR40;
VAR ST:STR160;
BEGIN ST:=VALUE; RDSTR(WINDOW,ST,40); VALUE:=ST; END;
PROCEDURE GRDSTR40;
VAR ST:STR160;
BEGIN ST:=VALUE; GRDSTR(ST,40); VALUE:=ST; END;
PROCEDURE rdstr30;
VAR ST:STR160;
BEGIN ST:=VALUE; RDSTR(WINDOW,ST,30); VALUE:=ST; END;
PROCEDURE Grdstr30;
VAR ST:STR160;
BEGIN ST:=VALUE; GRDSTR(ST,30); VALUE:=ST; END;
PROCEDURE rdstr20;
VAR ST :STR160;
BEGIN ST:=VALUE; RDSTR(WINDOW,ST,20); VALUE:=ST; END;
PROCEDURE Grdstr20;
VAR ST :STR160;
BEGIN ST:=VALUE; GRDSTR(ST,20); VALUE:=ST; END;
PROCEDURE rdstr3;
VAR ST : STR160;
BEGIN ST:=VALUE; RDSTR(WINDOW,ST,3); VALUE:=ST; END;
PROCEDURE Grdstr3;
VAR ST : STR160;
BEGIN ST:=VALUE; GRDSTR(ST,3); VALUE:=ST; END;
PROCEDURE rdcharln;
VAR ST:STR160;
BEGIN ST:=VALUE; RDSTR(WINDOW,ST,1); VALUE:=ST[1]; END;
PROCEDURE Grdchar;
VAR ST:STR160;
BEGIN ST:=VALUE; GRDSTR(ST,1); VALUE:=ST[1]; END;
{******************************************************************************}
{************** FUNCTION CALCINCR(INCR:DOUBLE):DOUBLE ************************}
{******************************************************************************}
FUNCTION CALCINCR;
{Calculates a round number increment given an approximate increment INCR.}
VAR POWER : LONGINT; FRACTION : DOUBLE;
BEGIN
POWER:=TRUNC(LOG(INCR)); FRACTION:=INCR/PWROF10(POWER);
WHILE FRACTION<1 DO BEGIN
POWER:=POWER-1; FRACTION:=INCR/PWROF10(POWER);
END; {WHILE}
IF FRACTION<2 THEN CALCINCR:=1.0E0 * PWROF10(POWER)
ELSE IF FRACTION<5 THEN CALCINCR:=2.0E0 * PWROF10(POWER)
ELSE IF FRACTION<10 THEN CALCINCR:=5.0E0 * PWROF10(POWER)
ELSE CALCINCR:=10.0E0 * PWROF10(POWER);
END; {FUNCTION CALCINCR}
{******************************************************************************}
{* PROCEDURE ENGNOT(NUMBER:DOUBLE; VAR MANTISSA:DOUBLE; VAR EXPONENT:LONGINT) *}
{******************************************************************************}
PROCEDURE ENGNOT;
{convert number to engineering notation}
BEGIN
IF NUMBER=0.0 THEN BEGIN
EXPONENT:=0; MANTISSA:=0.0;
END
ELSE BEGIN
EXPONENT:=TRUNC(LN(ABS(NUMBER))/LN(10));
IF LN(ABS(NUMBER))/LN(10) <0 THEN EXPONENT:=EXPONENT-1;
WHILE (EXPONENT MOD 3)<>0 DO EXPONENT:=EXPONENT-1;
MANTISSA:=NUMBER/PWROF10(EXPONENT);
END; {ELSE}
END; {PROCEDURE ENGNOT}
{*****************************************************************************}
{*************** FUNCTION NUMDEC(NUM:DOUBLE):INTEGER *************************}
{*****************************************************************************}
FUNCTION NUMDEC;
{calculates the number of decimals in a number - accurate to about 1 part
in 1E6}
VAR EXTRA : DOUBLE; DECIMALS : LONGINT;
BEGIN
DECIMALS:=0;
EXTRA:=NUM*PWROF10(DECIMALS);
WHILE (EXTRA-TRUNC(EXTRA+EXTRA*(1E-6))) > (1E-6)*EXTRA DO BEGIN
DECIMALS:=DECIMALS+1;
EXTRA:=NUM*PWROF10(DECIMALS);
END; {WHILE}
NUMDEC:=DECIMALS;
END; {FUNCTION NUMDEC}
{************************************************************************
TITLE : EXISTS(FILENAME:STR30):BOOLEAN
AUTHOR : Roger Carlson (August 1986)
FUNCTION : Checks if a file of the specified name already exists on disk.
INPUTS : FILENAME - Name of the file.
OUTPUTS : EXISTS - TRUE = file exists.
NOTES :
CHANGES : (5/30/90,RJC) - Translated to Turbo Pascal.
*************************************************************************}
FUNCTION EXISTS;
VAR TEMP:PATHSTR;
BEGIN
TEMP:=FSEARCH(FILENAME,'');
IF TEMP='' THEN EXISTS:=FALSE ELSE EXISTS:=TRUE;
END; {FUNCTION EXISTS}
{************************* PROCEDURE BEEP ******************************}
PROCEDURE BEEP;
{This procedure sounds a short alarm of frequency HZ.}
BEGIN
SOUND(HZ); DELAY(200); NOSOUND;
END;
{************************ FUNCTION INTTOSTR ****************************}
FUNCTION INTTOSTR;
VAR S:STR80;
BEGIN
STR(I,S); INTTOSTR:=S;
END;
{************************ FUNCTION LNGTOSTR *****************************}
FUNCTION LNGTOSTR;
VAR S:STR80;
BEGIN
STR(I,S); LNGTOSTR:=S;
END;
{************************ FUNCTION RLTOSTR ******************************}
FUNCTION RLTOSTR;
VAR S:STR80;
BEGIN
STR(RL:WIDTH,S); RLTOSTR:=S;
END;
END.